perm filename GUNFAI.FAI[SYS,HE] blob
sn#103139 filedate 1974-06-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00042 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 FAISUM
C00005 00003 FAISUM CONT.
C00007 00004 SUMINT: MOVE -5(P)
C00008 00005 ANGDIR, ANGLE
C00009 00006 SORINT
C00010 00007 SORLOD
C00011 00008 SORBOD
C00013 00009 SORBOD CONT.
C00015 00010 SORBOD CONT.
C00017 00011 SORBOD CONT.
C00019 00012 SORBOD CONT., ANGLEN, LDIST
C00021 00013 DNEW, MALI
C00023 00014 WEIFAI
C00024 00015 LININT, PROINT
C00026 00016 PLDIS
C00028 00017 PLDIS CONT.
C00029 00018 LNINTA
C00031 00019 FAIL CODE TO SPEED UP XREF
C00032 00020 ARINT
C00034 00021 XREF1, MINUM, CROSS
C00036 00022 TJOINT, ACTIV
C00038 00023 INNER
C00040 00024 CUTJN
C00042 00025
C00043 00026 XJOIN
C00045 00027 JL2: JUMPE 4,.+2 if at least one SV not bare, then
C00047 00028 XREF21
C00050 00029 XREF22, XREF30
C00052 00030 XREF31
C00055 00031 XREF32, INTER
C00057 00032 XREF41, XREF42, XREF50
C00059 00033 XXREF51, XREF7, XREF52
C00061 00034 XREF6
C00063 00035
C00065 00036 CONDIV, LACT
C00067 00037 LVNEXT
C00070 00038 LVNEXT CONT.
C00071 00039 LCRL, ANGSV
C00073 00040 PNTS
C00075 00041 PNTS CONT.
C00077 00042 LNES
C00079 ENDMK
C⊗;
; FAISUM
ENTRY FAISUM,SUMINT,ANGDIR,ANGLE,SORINT,SORLOD,SORBOD,ANGLEN,LCRL,LACT
ENTRY LININT,DNEW,WEIFAI,MALI,LDIST,PLDIS,ARINT,LNINTA,CONDIV,ANGSV,PNTS
ENTRY XREF1,XREF21,XREF22,XREF30,XREF31,XREF32,XREF41,XREF42,XREF50,XREF51
ENTRY XREF6,XREF7,XREF8,PROINT,LNES,LVNEXT,INNER,XREF52,CUTJN,XJOIN
TITLE GUNFAI - FAIL CODE FOR SPEEDING UP GUNLO
P←17;
SAV: BLOCK 20 ;SAVE REGISTERS HERE AS NECESSARY
;FOR SUMS PROCEDURE
EXTERNAL IHI,IHI2,SX,SY,SX2,SY2,SXY,LEKV
E11←0
E21←1
E12←2
E22←3
H←4
H1←5
H2←6
L←7
FAISUM: MOVE [XWD 12,SAV]
BLT SAV+3
MOVE H,IHI ;LOAD REGISTERS WITH POINTERS
MOVE H1,-6(P)
MOVE L,-7(P)
MOVE H2,IHI2
L100:
EAX1: MOVE E11,.(H) ;LOAD COORDINATES - ADDRS SET BY SUMINT
EBX1: MOVE E21,.(H)
EAY1: MOVE E12,.(H)
EBY1: MOVE E22,.(H)
MOVE 10,E11 ;CALCULATE NEXT SET OF VALUES
FADR 10,E21 ;X1+X2
MOVE 11,E12
FADR 11,E22 ;Y1+Y2
MOVE 12,E11
FMPR 12,E11
MOVE 13,E21
FMPR 13,E21
FADR 12,13 ;X1↑2+X2↑2
MOVE 13,E12
FMPR 13,E12
MOVE 14,E22
FMPR 14,E22
FADR 13,14 ;Y1↑2+Y2↑2
MOVE 14,E12
FMPR 14,E11
MOVE 15,E21
FMPR 15,E22
FADR 14,15 ;X1*X2+Y1*Y2
; FAISUM CONT.
CAME H,L
JRST L1
MOVEM 10,SX ;FIRST TIME THROUGH-STORE VALUES
MOVEM 11,SY
MOVEM 12,SX2
MOVEM 13,SY2
MOVEM 14,SXY
JUMPL H1,L101 ;MORE POINTS - CONTINUE
MOVE 10,[XWD SAV,12]
BLT 10,15
PUSH P,E11 ;OTHERWISE, GET COEFS. AND RETURN
PUSH P,E12
PUSH P,E21
PUSH P,E22
PUSH P,-11(P) ;ADDRS FOR COEFS. BACK ON STACK
PUSH P,-11(P)
PUSH P,-11(P)
MOVEM H,IHI ;THIS MAY HAVE BEEN CHANGED
PUSHJ P,LEKV
SETZM 1 ;FLAG FOR IMMEDIATE EXIT
POPJ P,
L101: CAMN H,H2
JRST L11 ;WE ARE DONE
AOJA H,L100 ;OTHERWISE, INC POINTER AND RETURN FOR MORE
L1: FADRM 10,SX ;THIS WAS NOT FIRST PAIR, ADD VALUES TO SUMS
FADRM 11,SY
FADRM 12,SX2
FADRM 13,SY2
FADRM 14,SXY
JUMPL H1,L101 ;RETURN FOR MORE POINTS
L11: MOVEM H,IHI ;DONE - EXIT
MOVE 10,[XWD SAV,12]
BLT 10,15
SETOM 1 ;NO IMMEDIATE RETURN
POPJ P,
SUMINT: MOVE -5(P)
HRRM EAX2
HRRM EAX3
HRRM EAX4
HRRM EAX5
HRRM EAX6
HRRM EAX7
SOS
HRRM EAX1
MOVE -4(P)
HRRM EAY2
HRRM EAY3
HRRM EAY4
HRRM EAY5
HRRM EAY6
HRRM EAY7
SOS
HRRM EAY1
MOVE -3(P)
HRRM EBX2
HRRM EBX3
HRRM EBX5
HRRM EBX6
HRRM EBX7
HRRM EBX8
HRRM EBX9
HRRM EBX10
SOS
HRRM EBX1
MOVE -2(P)
HRRM EBY2
HRRM EBY3
HRRM EBY5
HRRM EBY6
HRRM EBY7
HRRM EBY8
HRRM EBY9
HRRM EBY10
HRRM EBY11
HRRM EBY12
SOS
HRRM EBY1
MOVE -1(P)
HRRM LE1
HRRM LE2
HRRM LE3
HRRM LE4
HRRM LE5
HRRM LE6
HRRM LE7
SUB P,[XWD 6,6]
JRST @6(P)
; ANGDIR, ANGLE
EXTERNAL ATAN2$,AMOD
ANGDIR: PUSH P,-1(P)
PUSH P,-3(P)
PUSHJ P,ATAN2$
FADR 1,[6.2832]
PUSH P,1
PUSH P,[6.2832]
PUSHJ P,AMOD
FMPR 1,[57.29]
CAML 1,[360.0]
SETZM 1
SUB P,[XWD 3,3]
JRST @3(P)
ANGLE: POP P,RET# ;SAVE RETURN ADDR
PUSHJ P,ANGDIR ;ARG ALREADY THERE - WILL REDUCE STACK BY 2
MOVEM 1,TMP# ;SAVE RESULT
PUSHJ P,ANGDIR ;ARG THERE AGAIN - REDUCE STACK BY 2 MORE
MOVNS 1
FADR 1,TMP ;COMBINE
FADR 1,[360.0]
PUSH P,1
PUSH P,[360.0]
PUSH P,RET ;PUT RETURN BACK ON STACK
JRST AMOD ;AMOD WILL RETURN FOR US
; SORINT
SORINT: MOVE -6(P)
HRRM FAX1
HRRM FAX2
HRRM FAX3
HRRM FAX4
HRRM FAX5
HRRM FAX6
MOVE -5(P)
HRRM FAY1
HRRM FAY2
HRRM FAY3
HRRM FAY4
HRRM FAY5
HRRM FAY6
MOVE -4(P)
HRRM FBX1
HRRM FBX2
HRRM FBX3
HRRM FBX4
HRRM FBX5
HRRM FBX6
MOVE -3(P)
HRRM FBY1
HRRM FBY2
HRRM FBY3
HRRM FBY4
HRRM FBY5
HRRM FBY6
MOVE -2(P)
HRRM IFO1
HRRM IFO2
HRRM IFO3
HRRM IFO4
HRRM IFO5
HRRM IFO6
HRRM IFO7
HRRM IFO8
HRRM IFO9
MOVE -1(P)
HRRM IBA1
HRRM IBA2
HRRM IBA3
HRRM IBA4
HRRM IBA5
HRRM IBA6
HRRM IBA7
HRRM IBA8
SUB P,[XWD 7,7]
JRST @7(P)
; SORLOD
EXTERNAL NOEPA
; FOR SORTED - SORINT, SORLOD, SORBOD
SORLOD: SETZM 1
CAML 1,NOEPA
POPJ P,
LE1: SETZM .(1)
FAX1: MOVE 2,.(1)
FBX1: FADR 2,.(1)
FSC 2,-1
EAX2: MOVEM 2,.(1)
FAY1: MOVE 2,.(1)
FBY1: FADR 2,.(1)
FSC 2,-1
EAY2: MOVEM 2,.(1)
MOVE 2,[1000000.]
EBX2: MOVEM 2,.(1)
EBY2: MOVEM 2,.(1)
IFO8: SETOM .(1)
IBA8: SETOM .(1)
AOJA 1,SORLOD+1
XX←0
YY←1
IP←1
DX0←2
DY0←3
DXN←4
DYN←5
DX1←6
DY1←7
DXY1←10
DXY2←11
D2←12
NEXT←13
IW←14
T←15
U←16
GRAV: 0
RDEP2: 0
DDQ: 0
FAK: 0
A1: 0
A2: 0
; SORBOD
SORBOD: HRLI 1,-6(P)
HRRI 1,GRAV
BLT 1,A2 ;GET ARGUMENTS
SUB P,[XWD 7,7]
MOVE [XWD 12,SAV]
BLT SAV+4
SOS NOEPA ;REDUCE NOEPA BY ONE FOR TESTING
SETZM IW
LP1: CAML IW,NOEPA
JRST LP1END
EAX3: MOVE XX,.(IW) ;GET CENTER POINT AND PAIR-VECTOR
EAY3: MOVE YY,.(IW)
FBX2: MOVE DX0,.(IW)
FAX2: FSBR DX0,.(IW)
FBY2: MOVE DY0,.(IW)
FAY2: FSBR DY0,.(IW)
MOVEI NEXT,1(IW)
LP100: CAMLE NEXT,NOEPA
AOJA IW,LP1
MOVE T,XX ;IS NEW PAIR INSIDE WINDOW?
EAX4: FSBR T,.(NEXT)
MOVMS T
CAMLE T,GRAV
AOJA NEXT,LP100
MOVE T,YY
EAY4: FSBR T,.(NEXT)
MOVMS T
CAMLE T,GRAV
AOJA NEXT,LP100
FBX3: MOVE DXN,.(NEXT) ;YES - COMPUTE DIRECTED DISTANCES AND UPDATE
FAX3: FSBR DXN,.(NEXT) ; MINIMA. FIRST FIND VECTOR FOR NEW PAIR
FBY3: MOVE DYN,.(NEXT)
FAY3: FSBR DYN,.(NEXT)
FBX4: MOVE DX1,.(IW)
FAX4: FSBR DX1,.(NEXT)
FMPR DX1,[3.0]
FBX5: FADR DX1,.(NEXT)
FAX5: FSBR DX1,.(IW)
FBY4: MOVE DY1,.(IW)
FAY4: FSBR DY1,.(NEXT)
FMPR DY1,[3.0]
FBY5: FADR DY1,.(NEXT)
FAY5: FSBR DY1,.(IW)
MOVE DXY1,DX1
FMPR DXY1,DXY1
; SORBOD CONT.
MOVE T,DY1
FMPR T,T
FADR DXY1,T ;DXY1←DX1↑2+DY1↑2
MOVE DXY2,DX0
FADR DXY2,DXN
FMPR DXY2,[-4.0]
FADR DXY2,DX1
FMPR DXY2,DXY2
MOVE T,DY0
FADR T,DYN
FMPR T,[-4.0]
FADR T,DY1
FMPR T,T
FADR DXY2,T ;DXY2←(DX1-4*(DX0+DXN))↑2+(DY1-4*(DY0+DYN))↑2
CAMLE DXY1,DDQ ;DIRECTED DISTANCES TOO LARGE?
CAMG DXY2,DDQ
CAIA
AOJA NEXT,LP100
MOVE T,DX0
FADR T,DXN
FMPR T,T
MOVE U,DY0
FADR U,DYN
FMPR U,U
FADR T,U
FMPR T,T
FSBR T,A2 ;D2←1 MAX (A1/(.001 MAX (((DX0+DXN)↑2+
CAMGE T,[0.001] ;(DYO+DYN)↑2)↑2-A2)))
MOVE T,[0.001]
MOVE D2,A1
FDVR D2,T
CAMGE D2,[1.0]
MOVE D2,[1.0]
FMPR D2,D2
FSBR D2,[1.0]
FMPR D2,FAK
FMPR D2,RDEP2 ;D2←RDEP2*FAK*(D2↑2-1)
FADR DXY1,D2
FADR DXY2,D2
CAMLE DXY1,DDQ ;GO THROUGH MINIMUM VALUES AND UPDATE IF NEC.
JRST L101P
EBY5: CAMLE DXY1,.(IW)
JRST L102P
IFO1: MOVEM NEXT,.(IW) ;NEW MINIMUM FOR OLD FORWARD
EBY6: MOVEM DXY1,.(IW)
L102P:
EBX5: CAMLE DXY1,.(NEXT)
JRST L101P
; SORBOD CONT.
IBA1: MOVEM IW,.(NEXT) ;NEW MINIMUM FOR NEW BACKWARD
EBX6: MOVEM DXY1,.(NEXT)
L101P: CAMLE DXY2,DDQ
AOJA NEXT,LP100
EBY7: CAMLE DXY2,.(NEXT)
JRST L103P
IFO2: MOVEM IW,.(NEXT) ;NEW MINIMUM FOR NEW FORWARD
EBY8: MOVEM DXY2,.(NEXT)
L103P:
EBX7: CAMLE DXY2,.(IW)
AOJA NEXT,LP100
IBA2: MOVEM NEXT,.(IW) ;NEW MINIMUM FOR OLD BACKWARD
EBX8: MOVEM DXY2,.(IW)
AOJA NEXT,LP100
AOJA IW,LP1
; AT THIS POINT, ALL EDGE-PAIRS HAVE BEEN EQUIPPED WITH BOTH
; BACKWARD AND FORWARD POINTERS (NOT NECESSARILY RECIPROCATED.)
; CLEAN UP THE LINKAGES, AND BREAK UP LOOPS (ALTHOUGH VERY
; UNLIKELY) AT THEIR WEAKEST LINK
I8←2
WEAK←3
IWEAK←4
ONE←5
TWO←ONE+1
LP1END: SETZM I8
MOVEI ONE,1
LP8: CAMLE I8,NOEPA ;REMEMBER, STILL DEC BY ONE
JRST LP8END
LE7: SKIPE .(I8)
AOJA I8,LP8
SETZM WEAK
MOVEI IW,(I8)
L82:
LE2: MOVEM ONE,.(IW)
IFO3: MOVE NEXT,.(IW)
JUMPL NEXT,L80+1 ;CHAIN CONTINUES?
IBA3: CAME IW,.(NEXT)
JRST L80
EBY9: CAML WEAK,.(IW) ;YES, STEP NEXT
JRST L84
MOVEI IWEAK,(IW) ;NEW MAXIMUM FOR WEAK LINK
EBY10: MOVE WEAK,.(IW)
L84: MOVEI IW,(NEXT)
CAIE IW,(I8) ;DO WE HAVE A LOOP?
JRST L82
; SORBOD CONT.
IFO4: MOVE T,.(IWEAK) ;YES, BREAK AT WEAKEST LINK
IBA4: SETOM .(T)
IFO5: SETOM .(IWEAK)
AOJA I8,LP8
L80:
IFO6: SETOM .(IW) ;NO, THERE IS A BREAK, REVERSE
MOVEI IW,(I8)
L81:
IBA5: MOVE NEXT,.(IW)
JUMPL NEXT,L83+1 ;CHAIN CONTINUES?
IFO7: CAME IW,.(NEXT)
JRST L83
MOVEI IW,(NEXT) ;YES, STEP NEXT
LE3: MOVEM ONE,.(IW)
JRST L81
L83:
IBA6: SETOM .(IW) ;BREAK IN THE BACKWARD LINKAGE-END OF CHAIN
AOJA I8,LP8
; THE FOLLOWING RECOPIES ARRAYS ACCORDING TO CONNECTIVITY
LP8END: SETZM IP
MOVEI TWO,2
SETZM IW
LP5: CAMLE IW,NOEPA
JRST LP5END
IBA7: SKIPL .(IW)
AOJA IW,LP5
MOVEI NEXT,(IW)
LE4: MOVEM ONE,.(IP)
L7:
FAX6: MOVE T,.(NEXT)
EAX5: MOVEM T,.(IP)
FAY6: MOVE T,.(NEXT)
EAY5: MOVEM T,.(IP)
FBX6: MOVE T,.(NEXT)
EBX9: MOVEM T,.(IP)
FBY6: MOVE T,.(NEXT)
EBY11: MOVEM T,.(IP)
IFO9: MOVE NEXT,.(NEXT)
JUMPL NEXT,[AOS IP
AOJA IW,LP5]
LE5: ADDM TWO,.(IP)
AOS IP
LE6: MOVEM TWO,.(IP)
JRST L7
; SORBOD CONT., ANGLEN, LDIST
LP5END: AOS NOEPA ;PUT BACK NOEPA
MOVE [XWD SAV,12]
BLT 16
JRST @7(P)
; COMPUTES ANGLE AND LENGTH FOR LINE LL
EXTERNAL SQRT$
ANGLEN: MOVE 6,-1(P) ;LL
MOVEM 6,LL
MOVEI 3,(6)
ASH 3,1 ;IV2
MOVEI 2,-1(3) ;IV2-1
XLC1: MOVE 4,.(3)
XLC2: FSBR 4,.(2) ;DX←XLCOR[IV2]-XLCOR[IV2-1]
YLC1: MOVE 5,.(3)
YLC2: FSBR 5,.(2) ;DY←YLCOR[IV2]-YLCOR[IV2-1]
PUSH P,4
PUSH P,5
FMPR 4,4
FMPR 5,5
FADR 4,5
PUSH P,4
PUSHJ P,SQRT$
MOVE 6,LL
RLN1: MOVEM 1,.(6) ;RLEN[LL]←SQRT(DX↑2+DY↑2)
PUSHJ P,ANGDIR
MOVE 6,LL
ANG1: MOVEM 1,.(6) ;ANGARG[LL]←ANGDIR(DX,DY)
SUB P,[XWD 2,2]
JRST @2(P)
; Measures distance (signed) from (X,Y) to line L.
LDIST: MOVE 2,-1(P)
CXL3: MOVE 1,.(2)
FMPR 1,-3(P)
CYL3: MOVE 3,.(2)
FMPR 3,-2(P)
CCL3: FADR 1,.(2)
FADR 1,3
SUB P,[XWD 4,4]
JRST @4(P)
; DNEW, MALI
;COMPUTES MEAN DISTANCE FROM PROJECTED LINE TO NEW POINT-PAIR
DNEW: SOS 2,-4(P)
EAX6: MOVE 1,.(2)
FMPR 1,-3(P)
EAY6: MOVE 3,.(2)
FMPR 3,-2(P)
FADR 1,3
FADR 1,-1(P)
MOVMS 1
EBX3: MOVE 3,.(2)
FMPR 3,-3(P)
EBY3: MOVE 4,.(2)
FMPR 4,-2(P)
FADR 3,4
FADR 3,-1(P)
MOVMS 3
FADR 1,3
FSC 1,-1
SUB P,[XWD 5,5]
JRST @5(P)
; FINDS EQUATION AND OTHER INFORMATION FOR INSERTED LINE LL
MALI: HRLZI 6,-5(P)
BLT 6,4
MOVE 5,
LSH 5,1 ;IV2
MOVEI 6,-1(5) ;IV2-1
XLC4: MOVEM 1,(6)
YLC4: MOVEM 2,(6)
XLC5: MOVEM 3,(5)
YLC5: MOVEM 4,(5)
POP P,RET
MOVE 5,
CXL2: MOVEI 1,.(5)
PUSH P,1
CYL2: MOVEI 1,.(5)
PUSH P,1
CCL2: MOVEI 1,.(5)
PUSH P,1
PUSHJ P,LEKV
PUSH P,RET
JRST ANGLEN
; WEIFAI
;PART OF WEIGHV PROCEDURE
EXTERNAL W, CX, CY, CL
WEIFAI: MOVE 1,-1(P)
AOS 1
LSH 1,-1 ;LL←(ISV+1)%2
MOVEM 1,LL#
RLN2: PUSH P,.(1)
PUSHJ P,SQRT$
MOVEM 1,W ;W ← SQRT(RLEN[LL])
MOVE 1,LL
CXL1: MOVE .(1)
MOVEM CX
CYL1: MOVE .(1)
MOVEM CY
CCL1: MOVE .(1)
MOVEM CL
MOVE 1,-1(P)
XLC3: MOVE .(1)
FMPR W
FADRM SX
YLC3: MOVE .(1)
FMPR W
FADRM SY
SUB P,[XWD 2,2]
JRST @2(P)
; LININT, PROINT
;INITIALIZE ARRAY ADDRESS FOR LINE-VERTEX STRUCTURE AND PROTOTYPES
LININT: SOS 1,-7(P) ;MAKE ALL ADDRESS RELATIVE TO INDEX 0
HRRM 1,CXL1
HRRM 1,CXL2
HRRM 1,CXL3
HRRM 1,CXL4
SOS 1,-6(P)
HRRM 1,CYL1
HRRM 1,CYL2
HRRM 1,CYL3
HRRM 1,CYL4
SOS 1,-5(P)
HRRM 1,CCL1
HRRM 1,CCL2
HRRM 1,CCL3
SOS 1,-4(P)
HRRM 1,ANG1
HRRM 1,ANG2
HRRM 1,ANG3
SOS 1,-3(P)
HRRM 1,RLN1
HRRM 1,RLN2
HRRM 1,RLN3
SOS 1,-2(P)
HRRM 1,XLC1
HRRM 1,XLC2
HRRM 1,XLC3
HRRM 1,XLC4
HRRM 1,XLC5
HRRM 1,XLC6
HRRM 1,XLC7
HRRM 1,XLC8
HRRM 1,XLC9
HRRM 1,XLC10
HRRM 1,XLC11
HRRM 1,XLC12
HRRM 1,XLC13
HRRM 1,XLC14
HRRM 1,XLC15
SOS 1,-1(P)
HRRM 1,YLC1
HRRM 1,YLC2
HRRM 1,YLC3
HRRM 1,YLC4
HRRM 1,YLC5
HRRM 1,YLC6
HRRM 1,YLC7
HRRM 1,YLC8
HRRM 1,YLC9
HRRM 1,YLC10
HRRM 1,YLC11
HRRM 1,YLC12
HRRM 1,YLC13
HRRM 1,YLC14
HRRM 1,YLC15
SUB P,[XWD 10,10]
JRST @10(P)
PROINT: SOS 1,-1(P)
HRRM 1,PLIN1
SUB P,[XWD 2,2]
JRST @2(P)
; PLDIS
; Finds the shortest squared distance, R, from point (X,Y) to
; line I, and the corresponding coordinates, (XL,YL), on the
; line. IW ← 1 (else 0) iff (XL,YL) is outside the line segment.
; This routine is used in the insertion package. Assumes the
; topological connectivity as reflected in the line-coordinates.
AK←0
IV←1
XC←2
YC←3
CYY←4
XX←5
YY←6
I←7
XL←10
YL←11
PLDIS: MOVE XX,-7(P)
MOVE YY,-6(P)
MOVE I,-5(P)
SETZM @-1(P)
MOVEI IV,(I)
ASH IV,1
SUBI IV,1
MOVE AK,[1000.0]
CYL4: MOVE CYY,.(I)
XLC6: MOVE XC,.(IV)
YLC6: MOVE YC,.(IV)
JUMPE CYY,.+3
CXL4: MOVN AK,.(I) ;IF CY≠0
FDVR AK,CYY ;THEN AK←-CXL[I]/CY
MOVE YL,AK
FMPR YL,YY
FSBR YL,XC
FADR YL,XX
FMPR YL,AK
FADR YL,YC
MOVE 13,AK
FMPR 13,13
FADR 13,[1.0]
FDVR YL,13 ;YL←(YC+AK*(AK*Y-XC+X))/(1.0+AK↑2)
MOVE XL,YY
FSBR XL,YL
FMPR XL,AK
FADR XL,XX ;XL ← X+AK*(Y-YL)
; PLDIS CONT.
MOVE 13,XX
FSBR 13,XL
FMPR 13,13
MOVE 14,YY
FSBR 14,YL
FMPR 14,14
FADR 13,14
MOVEM 13,@-2(P) ;R ← (X-XL)↑2+(Y-YL)↑2
AOS IV ;IV+1
MOVMS AK
CAMLE AK,[1.0]
JRST XLC7+2
MOVE 13,XL
FSBR 13,XC
MOVE 14,XL
XLC7: FSBR 14,.(IV)
JRST YLC7+1
MOVE 13,YL
FSBR 13,YC
MOVE 14,YL
YLC7: FSBR 14,.(IV)
FMPR 13,14
CAMGE 13,[-1.0]
JRST .+3
MOVEI 13,1
MOVEM 13,@-1(P)
MOVEM XL,@-4(P)
MOVEM YL,@-3(P)
SUB P,[XWD 10,10]
JRST @10(P)
; LNINTA
; MORE ADDRESS INITIALIZATION FOR LINE-VERTEX STRUCTURE
LNINTA: SOS 1,-7(P)
HRRM 1,LVC1
HRRM 1,LVC2
HRRM 1,LVC3
HRRM 1,LVC4
HRRM 1,LVC5
HRRM 1,LVC6
HRRM 1,LVC7
HRRM 1,LVC8
HRRM 1,LVC9
HRRM 1,LVC10
SOS 1,-6(P)
HRRM 1,LVI1
SOS 1,-5(P) ;RELATIVE TO INDEX 1 AGAIN
HRRM 1,XVC1
HRRM 1,XVC2
HRRM 1,XVC3
HRRM 1,XVC4
HRRM 1,XVC5
HRRM 1,XVC6
HRRM 1,XVC7
HRRM 1,XVC8
SOS 1,-4(P)
HRRM 1,YVC1
HRRM 1,YVC2
HRRM 1,YVC3
HRRM 1,YVC4
HRRM 1,YVC5
HRRM 1,YVC6
HRRM 1,YVC7
HRRM 1,YVC8
SOS 1,-3(P)
HRRM 1,LCRE1
HRRM 1,LCRE2
HRRM 1,LCRE5
HRRM 1,LCRE6
HRRM 1,LCRE7
HRRM 1,LCRE8
SOS 1,-2(P)
HRRM 1,LVR1
HRRM 1,LVR2
HRRM 1,LVR3
HRRM 1,LVR4
HRRM 1,LVR5
HRRM 1,LVR6
HRRM 1,LVR7
HRRM 1,LVR8
HRRM 1,LVR9
;FAIL CODE TO SPEED UP XREF
SOS 1,-1(P)
HRRM 1,LNK1
HRRM 1,LNK2
HRRM 1,LNK3
AOS 1
HRRM 1,LNK4
SUB P,[XWD 10,10]
JRST @10(P)
RCDIS: 0
RWICS: 0
RLCV1: 0
RMLES: 0
RMALSS: 0
RWIC: 0
RMRLSS: 0
EXTERNAL LNCRE1, LNCRE2, MAXNOL, MAXNOV, I1, ICV1, ICV2, ISV1, ISV2
EXTERNAL R1, R2, KARN, IDUM, IV1, IV2, IL, I2, IP1, IP2, XTRACE, DEBOUT
EXTERNAL DCROSS, DMINUM, DTJOIN, DCLEAR, X, Y, IX1, IX2, DINS, DCOLIN
EXTERNAL RX, DCUTJN, DJOIN1, DJOIN2, DJOIN3, MERGE
; ARINT
;INITIALIZE ADDRESSES FOR XREF ARRAYS
ARINT: SOS 1,-7(P)
HRRM 1,IPK1
HRRM 1,IPK2
HRRM 1,IPK3
SOS 1,-6(P)
HRRM 1,RBK1
HRRM 1,RBK2
SOS 1,-5(P)
HRRM 1,RK1
HRRM 1,RK2
HRRM 1,RK3
HRRM 1,RK4
HRRM 1,RK5
HRRM 1,RK7
HRRM 1,RK8
HRRM 1,RK9
HRRM 1,RK10
HRRM 1,RK11
HRRM 1,RK12
HRRM 1,RK13
SOS 1
HRRM 1,RK6
SOS 1,-4(P)
HRRM 1,RAS1
HRRM 1,RAS2
HRRM 1,RAS3
HRRM 1,RAS4
HRRM 1,RAS5
SOS 1,-3(P)
HRRM 1,RBS1
HRRM 1,RBS2
HRRM 1,RBS4
HRRM 1,RBS5
SOS 1,-2(P)
HRRM 1,RCOL1
HRRM 1,RCOL2
HRRM 1,RCOL3
HRRM 1,RCOL4
HRRM 1,RCOL5
HRRM 1,RCOL6
HRRM 1,RCOL7
SOS 1,-1(P)
HRRM 1,IPS1
HRRM 1,IPS2
HRRM 1,IPS3
HRRM 1,IPS4
SUB P,[XWD 10,10]
JRST @10(P)
; XREF1, MINUM, CROSS
; save parameters for other routines
XREF1: HRLI 1,-7(P)
HRRI 1,RCDIS
BLT 1,RMRLSS
MOVE 1,MAXNOL ;clear links for all active lines
JUMPLE 1,XL1+2
LCRE1: SKIPGE 3,.(1)
JRST XL1
ANDI 3,7777
CAML 3,LNCRE1
CAMLE 3,LNCRE2
JRST XL1
MOVEI 2,(1)
LSH 2,1
LNK1: SETZM .(2)
LNK4: SETZM .(2)
XL1: SOJG 1,LCRE1
SUB P,[XWD 10,10]
JRST @10(P)
; set entries for new minimum distance, R1, from V to intersection
; V in AC1, R1 in AC3
; other vertex and distance in AC2 and AC4
MINUM: SKIPGE IDUM
MOVNS 2 ;negative if colinear lines
RAS1: MOVEM 3,.(1)
RBS2: MOVEM 4,.(1)
IPS2: MOVEM 2,.(1)
SKIPN XTRACE
POPJ P,
PUSH P,1
PUSH P,2
PUSHJ P,DMINUM
POPJ P,
; set entries for line of vertex V1 intersecting inside V2
; V1 in AC1, R1 in AC3, V2 in AC2, R2 in AC4
CROSS:
RK3: MOVEM 3,.(1)
RBK1: MOVEM 4,.(1)
IPK1: MOVEM 2,.(1)
SKIPN XTRACE
POPJ P,
PUSH P,1
PUSH P,2
PUSHJ P,DCROSS
POPJ P,
; TJOINT, ACTIV
; lines cross - shorten one to get T-joint
TJOINT: MOVE 1,IV1 ; AC1 is closest SV to intersection
MOVE 2,R1
CAMLE 2,R2 ; it will be shortened
MOVE 1,IV2
LVC3: MOVE 2,.(1) ; get CV for this SV
MOVE 3,X
XVC6: MOVEM 3,.(2) ; and save coords of intersection
MOVE 3,Y
YVC6: MOVEM 3,.(2) ; note that we do not change SV coords
SKIPN XTRACE
JRST TL1
PUSH P,1
PUSH P,2
PUSH P,1
PUSHJ P,DTJOIN
POP P,1
TL1: CAMN 1,IV1 ; test for closest crossing
JRST [ MOVE 2,IV2
MOVE 3,R1
SETZM 4
JRST TL2]
MOVE 2,IV1
MOVE 4,R2
SETZM 3
TL2: JRST CROSS
; skip one inst. if line in ac2 is active and not wholely inside another
; leaves larger of line's SVs in ac2
ACTIV: SETZM 1 ; set fail return for calling subr
LCRE2: SKIPG 3,.(2) ; check line in AC2 for active
POPJ P, ; fail - not in use
ANDI 3,7777
CAML 3,LNCRE1
CAMLE 3,LNCRE2
POPJ P, ; fail - not on active list
LSH 2,1 ; get larger of line's SVs in AC2
RK1: SKIPGE .(2) ; test if wholely inside another
POPJ P, ; fail - it is
AOS (P) ; success exit
POPJ P,
; INNER
; process the result of last intersection after determining if the
; intersection in inside or outside of each of the lines
INNER: SKIPG IP1
JRST ION
SKIPG IP2
JRST ITNA
SKIPN -2(P) ; outside both lines
JRST IOUT ; gross distance wrong
MOVE 1,IV1
MOVE 3,R1
RAS2: CAML 3,.(1)
JRST IL1
MOVE 2,IV2 ; new minimum for first line
MOVE 4,R2
PUSHJ P,MINUM
IL1: SKIPN -1(P) ; if desired, test second line
JRST IOUT
MOVE 1,IV2
MOVE 3,R2
RAS3: CAML 3,.(1)
JRST IOUT
MOVE 2,IV1 ; new minimum for second line
MOVE 4,R1
PUSHJ P,MINUM
JRST IOUT
ITNA: MOVE 1,IV1 ; outside first line, inside second
MOVE 3,R1
RK7: CAML 3,.(1)
JRST IOUT
MOVE 2,IV2 ; new minimum for second line
MOVE 4,R2
PUSHJ P,CROSS
JRST IOUT
ION: SKIPG IP2
JRST ITNB
MOVE 1,IV2 ; outside second line, inside first
MOVE 3,R2
RK8: CAML 3,.(1)
JRST IOUT
MOVE 2,IV1 ; new minimum for first line
MOVE 4,R1
PUSHJ P,CROSS
CAIA
ITNB: PUSHJ P,TJOINT ; inside both lines
IOUT: SUB P,[XWD 3,3]
JRST @3(P)
; CUTJN
; merge CV of ends with small cut stops
ACSAV: BLOCK 7
CUTJN: MOVE 1,I1 ;get SV in 1
IPK2: MOVE 2,.(1) ;get SV it cuts in 2
RK10: MOVE 3,.(1) ;get distance in 3 and 4
RBK2: MOVE 4,.(1)
MOVEI 5,2(1) ;get line ID of cut SV in 5
LSH 5,-1
LVR6: MOVM 6,.(1) ;6 and 7 true if SVs not bare
CAIN 6,(1)
SETZM 6
LVR7: MOVM 7,.(2)
CAIN 7,(2)
SETZM 7
SKIPN XTRACE
JRST CUTL
MOVE 10,[XWD 1,ACSAV]
BLT 10,ACSAV+6
PUSH P,2
PUSH P,6
PUSH P,7
PUSH P,3
PUSH P,4
PUSH P,5
PUSHJ P,DCUTJN
MOVE 10,[XWD ACSAV,1]
BLT 10,7
CUTL: JUMPE 6,.+3 ; merge if at least one SV bare
JUMPN 7,COUT
JUMPN 6,.+5
SKIPE -1(P) ; or first bare and third pass and
RK11: CAMGE 3,.(2) ; dist less for this SV
CAIA
JRST COUT
CL3: CAMG 3,RMLES ; and dist for this SV<RMLE↑2
CAMLE 4,RMALSS ; or dist for other SV≤RMALS↑2
JRST COUT
RLN3: MOVE 10,.(5)
FMPR 10,10
FMPR 10,RMRLSS ; and other SV≤RMRLSS*length of line
CAMLE 4,10
JRST COUT
JUMPE 6,LVC4
PUSH P,1 ; if first SV not bare, compute dist↑2
PUSH P,2 ; from first CV to line 2
PUSH P,5
MOVE 1,@LVC5
XCT XVC1
XCT YVC1
PUSH P,5
PUSH P,[X]
PUSH P,[Y]
PUSH P,[R2]
PUSH P,[IP1]
PUSHJ P,PLDIS
POP P,5
MOVEI 4,(5)
XCT XLC12 ; and compute dist↑2 from intersection
FSBR 2,X ; to cut SV
FMPR 2,2
XCT YLC12
FSBR 3,Y
FMPR 3,3
FADR 3,2
MOVE 4,3
POP P,2
POP P,1
MOVE 3,R2
SETZM 6 ; clear ¬bare flag
JRST CL3 ; try again with this distances
LVC4: PUSH P,.(1) ; merge
LVC5: PUSH P,.(2)
PUSH P,[0]
PUSHJ P,MERGE
COUT: SUB P,[XWD 2,2]
JRST @2(P)
; XJOIN
; join acceptable extension intersections into CVs
XJOIN: MOVE 1,I1 ; get SV in 1
IPS3: MOVE 2,.(1) ; get other SV in 2
SETZM 3
JUMPGE 2,RAS5
MOVMS 2
SKIPE -1(P)
IPS4: MOVEM 2,.(1) ; clear collinear flag if pass 2
RAS5: MOVE 4,.(1) ; get distance for this SV in 4
SKIPN XTRACE
JRST JL1
MOVE 5,[XWD 1,ACSAV]
BLT 5,ACSAV+3
PUSH P,2
PUSH P,4
PUSHJ P,DJOIN1
MOVE 5,[XWD ACSAV,1]
BLT 5,4
JL1: CAMLE 4,RX ; return if dist over threshold
JRST JOUT
RBS5: MOVE 5,.(1) ; or dist to other SV over thres
CAMG 5,RX
RK12: CAML 4,.(1) ; or cut dist less (intervening line)
JRST JOUT
LVR8: MOVM 4,.(1) ; 4 and 5 true if SVs bare
CAIE 4,(1)
SETZM 4
LVR9: MOVM 5,.(2)
CAIE 5,(2)
SETZM 5
LVC6: MOVE 6,.(1) ; 6 and 7 are current CVs of SVs 1 and 2
LVC7: MOVE 7,.(2)
CAIN 6,(7) ; return if already have same CVs
JRST JOUT
SKIPN XTRACE
JRST JL2
MOVE 10,[XWD 1,ACSAV]
BLT 10,ACSAV+6
PUSH P,4
PUSH P,5
PUSHJ P,DJOIN2
MOVE 10,[XWD ACSAV,1]
BLT 10,7
JL2: JUMPE 4,.+2 ; if at least one SV not bare, then
JUMPN 5,JL3
XVC7: MOVE 10,.(7) ; get coords of both CVs
YVC7: MOVE 11,.(7)
XVC8: MOVE 13,.(6)
YVC8: MOVE 14,.(6)
JUMPE 4,JL4
JUMPE 5,JL5
FSBR 10,13 ;neither bare, compute dist↑2 between
FSBR 11,14
FMPR 10,10
FMPR 11,11
FADR 10,11
JRST JL6
JL5: PUSH P,10 ; 1st SV bare, compute dist to 2nd
PUSH P,11
PUSH P,IL
JRST JL7
JL4: PUSH P,13 ; 2nd SV bare, compute dist to 1st
PUSH P,14
MOVEI 10,1(2)
LSH 10,-1
PUSH P,10
JL7: MOVE 10,[XWD 3,ACSAV]
BLT 10,ACSAV+4
PUSHJ P,LDIST
MOVM 10,1
MOVE 11,[XWD ACSAV,3]
BLT 11,7
JL6: SKIPN XTRACE
JRST JL10
MOVE 11,[XWD 3,ACSAV]
BLT 11,ACSAV+4
PUSH P,10
SKIPE 4 ↔ SETOM 4 ↔ SKIPE 5 ↔ SETOM 5 ↔ ANDCB 4,5 ↔ PUSH P,4
PUSHJ P,DJOIN3
MOVE 11,[XWD ACSAV,3]
BLT 11,7
JL10: MOVE 1,RCDIS ; test against RCDIS if neither bare, RWIC
SKIPE 4 ; otherwise
SKIPN 5
MOVE 1,RWIC
CAMLE 10,1 ; dist must be under toler to merge
JRST JOUT
JL3: PUSH P,6 ; merge
PUSH P,7
PUSH P,[0]
PUSHJ P,MERGE
JOUT: SUB P,[XWD 2,2]
JRST @2(P)
; XREF21
; succeeds iff ACTIV succeeds for line I1 at least one end is linked to
; another line and the intersection with this line is farther away
; than either some line which it cuts or which is colinear to it.
; ICV1 and ICV2 true if that end meets above conditions - if true,
; minimum score and link for that end deleted
XREF21: MOVE 2,I1 ; check if active and not gobbled
PUSHJ P,ACTIV
POPJ P,
MOVEM 2,ISV1 ; save vertex as ISV1
MOVEI 3,ICV2 ; flag for first end
IPS1: MOVM 5,.(2) ; AC5 is end of another line closest
JUMPE 5,[ ; to this end, if any
XL2: SETZM (3)
JRST XL3]
RK2: MOVE 6,.(5) ; AC6 is distance from AC5 to cut
RBS1: CAMGE 6,.(2) ; test if less than distance to AC2
JRST [
XL4: SETOM (3) ; yes - flag this vertex
SKIPN XTRACE
JRST RAS4-2
PUSH P,2
PUSH P,3
PUSH P,2
PUSHJ P,DCLEAR
POP P,3
POP P,2
SETZM @IPS1
MOVE 7,[900000.0]
RAS4: MOVEM 7,.(2)
JRST XL3]
RCOL1: MOVE 7,.(5) ; AC7 is distance from AC5 to
FSC 7,1 ; colinerar when scaled by 2
RBS4: CAMGE 7,.(2) ; test if less than distance to AC2
JRST XL4 ; yes - flag this vertex
JRST XL2
XL3: TRNN 2,1 ; if vertex # odd, we are done
JRST [ MOVEI 3,ICV1 ; flag for other end
SOJA 2,IPS1] ; get vertex number and test it
MOVE 1,ICV1 ; succeeds if either flag set
ADD 1,ICV2
POPJ P,
; XREF22, XREF30
; succeeds if ACTIV succeeds for line I1 and it has at least one end not
; linked to other lines (bare vertex)
XREF22: MOVE 2,I1 ; check if active and not gobbled
MOVEI 4,ISV1 ; store SV here
XREFXX: PUSHJ P,ACTIV
POPJ P,
MOVEM 2,(4) ; save vertex as ISVn
LVR1: MOVM 5,.(2) ; test for vertex bare
CAIE 5,(2)
JRST [ TRNN 2,1 ; if ever, one more vertex to test
SOJA 2,LVR1
POPJ P,]
SETOM 1 ; at least one is bare - succeed
POPJ P,
; same as XREF31 except updates colinearity tables if indicated
XREF30: MOVE 1,I1 ;get first vertex
LSH 1,1
MOVEM 1,ISV1
PUSHJ P,XREF31 ;do most of the work here
JUMPE 1,FAILO
MOVE 6,IDUM ;test for collinearity
CAME 6,[-1]
POPJ P, ;if lines not colinear, finished
MOVE 4,R1
RCOL4: CAMGE 4,.(3) ; check if distances for colinearity
RCOL5: CAML 4,.(5) ; is minimum for both vertices
POPJ P,
LNK2: MOVEM 5,.(3) ; yes - update colinearity links
LNK3: MOVEM 3,.(5)
RCOL6: MOVEM 4,.(3)
RCOL7: MOVEM 4,.(5)
SKIPN XTRACE
POPJ P,
PUSH P,3
PUSH P,5
PUSHJ P,DCOLIN
SETOM 1
POPJ P,
; XREF31
; succeeds if ACTIV succeeds for line I2 active, I2≠ I1. If successful,
; intersect two lines. If one line entirely inside the other, flag
; vertices and exit; otherwise leave IV1, IV2 (the closest vertices
; to the intersection) in AC3 and 5 and succeed if IP1≠0
XREF31: MOVE 2,I2
CAMN 2,I1
JRST [ SETZM 1
POPJ P,]
PUSHJ P,ACTIV ; check if active and wholely inside
POPJ P,
MOVEM 2,ISV2
XL5: MOVEI 3,-1(2) ; get other vertex
MOVE 4,ISV1 ; get vertices of other line
MOVEI 5,-1(4)
PUSHJ P,INTER ;intersect lines
SETZM 1 ; return flag clobbered by INTER
SKIPE XTRACE
PUSHJ P,DEBOUT ; write debugging info if requested
MOVE IDUM
CAML [-1] ; test for gobbled line
JRST XL20
MOVE 2,ISV1 ; found, get high SV for gobbled line
CAME [-2]
MOVE 2,ISV2
SETOM @RK1 ; and flag both vertices
RK6: SETOM .(2)
SKIPN XTRACE ; write debugging info if requested
POPJ P, ; otherwise fail - no more processing
PUSH P,2 ; needed for this pair
PUSHJ P,DINS
SETZM 1
POPJ P,
XL20: SKIPN IP1 ; if no intersection, finished
POPJ P,
MOVM 3,IP1 ; save closest vertices to intersect
ADD 3,ISV1 ; in IV1 and IV2
SUBI 3,2
MOVEM 3,IV1
MOVM 5,IP2
ADD 5,ISV2
SUBI 5,2
MOVEM 5,IV2
SETOM 1
POPJ P,
; XREF32, INTER
; intersect lines I1-I2 and CV1-CV2
XREF8: MOVE 5,I1
MOVE 4,I2
MOVE 3,ICV1
MOVE 2,ICV2
SKIPA 6,[1] ; do not check colinearities
INTER: SETZM 6 ; entry for internal calls
XLC8: PUSH P,.(5)
YLC8: PUSH P,.(5)
XLC9: PUSH P,.(4)
YLC9: PUSH P,.(4)
XLC10: PUSH P,.(3)
YLC10: PUSH P,.(3)
XLC11: PUSH P,.(2)
YLC11: PUSH P,.(2)
PUSH P,6
PUSHJ P,KARN
MOVEM 1,IDUM
POPJ P,
; same as XREF31 except also must have one end bare
XREF32: MOVE 2,I2 ;check line for active
MOVEI 4,ISV2
PUSHJ P,XREFXX
JUMPE 1,FAILO
AOJA 2,XL5 ;join XREF31 for rest of job
; XREF41, XREF42, XREF50
; test closest vertices to intersection on each line
; fails if neither is bare (XREF41 only), or if either distance is
; greater than a cut or colinear distance saved for that vertex
XREF41: SETZM 1
MOVE 2,IV1 ; {AC2=IV1}
MOVE 3,IV2 ; {AC3=IV2}
LVR3: MOVM 4,.(2) ; test if bare
CAIE 4,(2)
POPJ P,
LVR4: MOVM 4,.(3)
CAIE 4,(3)
POPJ P,
JRST XREF4
XREF42: SETZM 1 ; ALTERNATE ENTRY
MOVE 2,IV1 ; {AC2=IV1}
MOVE 3,IV2 ; {AC3=IV2}
XREF4: MOVE 4,R1 ; {AC4=R1}
MOVE 5,R2 ; {AC5=R2}
RK4: CAMG 4,.(2) ; test cut distances
RK5: CAMLE 5,.(3)
POPJ P,
RCOL2: MOVE 6,.(2) ; test 2*colinear distances
FSC 6,1
CAMLE 4,6
POPJ P,
RCOL3: MOVE 6,.(3)
FSC 6,1
CAMLE 5,6
POPJ P,
SETOM 1
POPJ P,
; succeeds if ACTIV succeeds for line of SV I1. Stores line # in IL
XREF50: MOVE 4,I1 ; AC2 ← line of SV I1
MOVEI 2,1(4)
LSH 2,-1
MOVEM 2,IL
PUSHJ P,ACTIV
POPJ P,
SETOM 1
POPJ P,
; XXREF51, XREF7, XREF52
; same as XREF5 except also tests if lin I1 is bare
XREF51: MOVE 4,I1
MOVEI 2,1(4)
LSH 2,-1
MOVEM 2,IL
PUSHJ P,ACTIV
POPJ P,
LVR2: MOVM 3,.(4) ; test if bare
CAIN 3,(4)
XL8: SETOM 1
POPJ P,
; succeeds if distance from vertex I1 to vertex I2 < RCDIS
XREF7: MOVE 2,I1
MOVE 3,I2
XVC2: MOVE 4,.(2)
XVC3: FSBR 4,.(3)
FMPR 4,4
YVC2: MOVE 1,.(2)
YVC3: FSBR 1,.(3)
FMPR 1,1
FADR 1,4
CAMG 1,RCDIS
SETZM 1
POPJ P,
; same as XREF50 except also fails if line not cut
XREF52: PUSHJ P,XREF50
JUMPE 1,FAILO
MOVE 1,I1
RK9: MOVE 2,.(1)
CAML 2,[900000.0]
SETZM 1
FAILO: POPJ P,
; XREF6
; this routine finds the closest CV to SV I1 of line IL, within a
; tolerance, and merges them if o.k.
XREF6: MOVE 1,IP2 ; get CVs of each end of IL
LVC8: MOVE 1,.(1)
MOVEM 1,ICV1
MOVE 1,I1
LVC9: MOVE 1,.(1)
MOVEM 1,LCV1#
MOVEI 1,1 ; search all CVs
XREFL: CAMLE 1,MAXNOV
JRST XREFL2
PUSH P,1
MOVEM 1,I2
PUSH P,[-1]
PUSHJ P,LVNEXT ; ignore CV if not active
JUMPE 1,[
MOVE 1,I2
AOJA 1,XREFL]
MOVE 1,I2
CAMN 1,LCV1 ; or already linked to an end of IL
AOJA 1,XREFL
CAMN 1,ICV1
AOJA 1,XREFL
XVC1: PUSH P,.(1) ; get dist↑2 from CV to IL (in R2) and
YVC1: PUSH P,.(1) ; coordinates of point where perp.
PUSH P,IL ; from CV to IL intersects IL
PUSH P,[X] ; in X,Y. IP1 false if intersection
PUSH P,[Y] ; on IL (on its extension)
PUSH P,[R2]
PUSH P,[IP1]
PUSHJ P,PLDIS
MOVE 1,I2
SKIPG IP1 ; reject SV if intersection on IL
AOJA 1,XREFL
MOVE 2,RWICS
FSC 2,1
CAMGE 2,R2 ; or R2> 2*RWICS
AOJA 1,XREFL
MOVE 4,I1
XLC12: MOVE 2,.(4)
FSBR 2,X
FMPR 2,2 ; or dist↑2 from intersection to
YLC12: MOVE 3,.(4) ; SV (R2←) > current minimum
FSBR 3,Y ; for this SV
FMPR 3,3
FADR 2,3
CAML 2,R1
AOJA 1,XREFL
MOVE 3,IP2
XLC13: MOVE 4,.(3) ; or intersection closer to opp.
FSBR 4,X ; SV on IL
FMPR 4,4
YLC13: MOVE 5,.(3)
FSBR 5,Y
FMPR 5,5
FADR 4,5
CAML 2,4
AOJA 1,XREFL
MOVEM 2,R1 ; otherwise, store new minimum and CV
MOVEM 1,ICV2
AOJA 1,XREFL
; now we have found the closest CV
XREFL2: MOVE 1,R1 ; test for minimum dist↑2<toler.
CAML 1,RX
POPJ P,
MOVE 2,I1
RK13: CAMGE 1,.(2) ; dist↑2 must also be < cut dist for
JRST XL30 ; SV or
IPK3: MOVE 2,.(2) ; cut SV must be linked to this CV
LVC10: MOVE 2,.(2)
CAME 2,ICV2
POPJ P,
XL30: PUSH P,LCV1 ;ok - merge
PUSH P,ICV2
PUSH P,[0]
PUSHJ P,MERGE
POPJ P,
; CONDIV, LACT
;RETURNS (0,1,2) IF OUTGOING LINE-PAIRS ARE (//&DIV. //&CONV., NEITHER
CONDIV: MOVE 1,-1(P)
PLIN1: MOVE 2,.(1) ;GET ENTRY IN PLINEF
SETZM 1
AND 2,[XWD 30,30] ;GET CONV/DIV BITS FOR EACH DIRECTION
LSH 2,-3 ;MOVE TO HALF WORD BOUNDARY
HLRZ 3,2 ;SEPERATE HALVES
JRST @.+1(2) ;DECODE
JRST @LZ(3) ; RIGHT HALF = 0
JRST LC1 ; 1
JRST @LZ(3) ; 2
JRST @LT(3) ; 3
LZ: JRST LC2 ; LEFT HALF = 0
JRST LC1 ; 1
JRST LC2 ; 2
JRST LC0 ; 3
LT: JRST LC0 ; 0
JRST LC1 ; 1
JRST LC0 ; 2
JRST LC0 ; 3
LC2: SKIPA 1,[2] ;NEITHER SIDE WAS 1 OR 3
LC1: ADDI 1,1 ;AT LEAST ONE SIDE WAS 1
LC0: SUB P,[XWD 2,2] ;NEITHER SIDE WAS 1 BUT ONE SIDE WAS 3
JRST @2(P)
; Returns True iff line L is active.;
; INTERNAL SIMPLE INTEGER PROCEDURE LACT(INTEGER L);
; RETURN((IA←LCREDE[L] LAND '400000007777)≥LNCRE1∧IA≤LNCRE2);
LACT: SETOM 1
MOVE 2,-1(P)
LCRE6: SKIPG 2,.(2)
JRST LOUT
ANDI 2,7777
CAML 2,LNCRE1
CAMLE 2,LNCRE2
LOUT: SETZM 1
SUB P,[XWD 2,2]
JRST @2(P)
; LVNEXT
; Initializes to (and returns) the first s.v. under the
; c.v. LCV, iff LCV≠0.
; If LCV<0, inactive lines are included throughout the process.
; If LCV=0, LVNEXT returns the s.v. (signed) pointed to next, and
; moves the pointer.
; Temporary and permanent connections are counted alike.
; LVNEXT returns 0 iff the c.v. does not exist, or LCV>0 and the
; c.v. is inactive, or all the s.v:s have been returned already.
; IW indicates which procedure is currently calling LVNEXT.
; We may have pointers in several different vertices, from
; several procedures, at any given time. IW-codes are:
; 1 = NLINCV 2 = LVERPT 3 = KSCVCO 4 = MSCVCO
; 5 = MERCV 6 = LINDEL 8 = LCOMCV 9 = WEIGHV
;
; this routine knows that temp/perm feature not used
; If IW<0, return with first good s.v.;
IIDUM←1
NEXT←2
LVS←3
LVSAV←4
LCV←5
IW←6
TP←7
IPTR: BLOCK =9
IFLG: BLOCK =9
LVNEXT: SETZM IIDUM ; SET UP FOR NULL RETURN
MOVE IW,-1(P) ; CALLING ROUTINE INDEX
SKIPN LCV,-2(P) ; GET C.V. ID
JRST LVA ; IF ZERO, ALREADY INITIALIZED
MOVM TP,LCV ; OTHERWISE, INITIALIZE LOOP
LVI1: SKIPG NEXT,.(TP)
JRST LVOUT ; INACTIVE C.V., TAKE NULL EXIT
MOVEI LVS,(NEXT) ; THIS IS FIRST S.V. POINTER
LVD: MOVEI LVSAV,(NEXT) ; SAVE POINTER
LVR5: MOVM NEXT,.(NEXT) ; GET NEXT POINTER
JUMPL LCV,LVB ; ALL S.V.S WANTED
MOVEI TP,1(LVSAV) ; ONLY ACTIVE S.V.S WANTED
LSH TP,-1 ; COMPUTE LINE I.D.
LCRE7: SKIPG TP,.(TP) ; AND TEST IF ACTIVE
JRST LVC
ANDI TP,7777
CAML TP,LNCRE1
CAMLE TP,LNCRE2
JRST LVC
LVB: JUMPL IW,LVE ; ONLY FIRST LINE WANTED
; LVNEXT CONT.
HRRM NEXT,IPTR-1(IW) ;THIS S.V. OK, WAVE POINTERS
HRLM LVS,IPTR-1(IW)
MOVEM LCV,IFLG-1(IW)
LVE: MOVEI IIDUM,(LVSAV) ; AND RETURN THIS S.V.
LVOUT: SUB P,[XWD 3,3]
JRST @3(P)
LVA: HLRZ LVS,IPTR-1(IW) ; ENTRY WHEN ALREADY INITED
HRRZ NEXT,IPTR-1(IW) ; SET UP POINTERS
MOVE LCV,IFLG-1(IW)
LVC: CAIE NEXT,(LVS) ; END OF RING OF S.V.S?
JRST LVD ; NO - PROCESS THIS S.V.
JRST LVOUT ; YES - TAKE NULL RETURN
DEFINE DISX(X) {
FSBR X,IRX
FMPR X,DSCX
FADR X,DX
FIX X,233000}
DEFINE DISY(Y) {
FSBR Y,IRY
FMPR Y,DSCY
FADR Y,DY
FIX Y,233000}
; LCRL, ANGSV
; return LCREDE entry for line L (sign and low 4 octal digits only);
;INTERNAL SIMPLE INTEGER PROCEDURE LCRL(INTEGER L);
; RETURN(LCREDE[L] LAND '400000007777);
LCRL: MOVE 1,-1(P)
LCRE5: MOVE 1,.(1)
AND 1,[400000007777]
SUB P,[XWD 2,2]
JRST @2(P)
; Returns angle from ISV1 to ISV2, assuming they are joined;
;SIMPLE REAL PROCEDURE ANGSV(INTEGER ISV1,ISV2);
; RETURN(IF ISV1=ISV2 THEN 360. ELSE
; AMOD(ANGARG[(ISV2+1)%2]-ANGARG[(ISV1+1)%2]+
;; (IF 1 LAND ISV2 THEN 0. ELSE 180.)-
; (IF 1 LAND ISV1 THEN 0. ELSE 180.)+720.,360.));
ANGSV: MOVE 1,[360.0]
MOVE 2,-1(P)
CAMN 2,-2(P)
JRST [SUB P,[XWD 3,3]
JRST @3(P)]
MOVE 4,[720.0]
TRNN 2,1
FADR 4,[180.0]
MOVEI 2,1(2)
LSH 2,-1
ANG2: FADR 4,.(2)
MOVE 2,-2(P)
TRNN 2,1
FSBR 4,[180.0]
MOVEI 2,1(2)
LSH 2,-1
ANG3: FSBR 4,.(2)
MOVEM 4,-2(P)
MOVEM 1,-1(P)
JRST AMOD
; PNTS
EXTERNAL RPOINT,WIND,RVECT,LOCT,IAEDG,IRX,IRY,DSCX,DSCY,DRX,DRY
X1←1
Y1←2
X2←3
Y2←4
IE←5
IG←6
IB←7
IC←10
ID←11
SAVX: BLOCK 5
PNTS: MOVEI 5
ADD LOCT
CAMGE [-=510]
MOVNI =510
MOVEM TST#
MOVE DRX
FSC 233
FADR [0.5]
MOVEM DX#
MOVE DRY
FSC 233
FADR [0.5]
MOVEM DY#
MOVE IAEDG
SETZM TS#
CAIN 2
SETOM TS
SETZM IE
SETZM IG
MOVEI IB,1
MOVEM IB,SAVX+4
CAMLE IB,NOEPA
POPJ P,
EAX7: MOVE X1,.(IB)
EAY7: MOVE Y1,.(IB)
EBX10: MOVE X2,.(IB)
EBY12: MOVE Y2,.(IB)
; PNTS CONT.
DISX X1
DISY Y1
DISX X2
DISY Y2
SKIPN WIND
JRST PL1
CAML X1,[-=510]
CAILE X1,=510
JRST PL2
CAML X2,[-=510]
CAIL X2,=510
JRST PL2
CAML Y1,TST
CAILE Y1,=510
JRST PL2
CAML Y2,TST
CAILE Y2,=510
JRST PL2
PL1: MOVE IC,IE
MOVE ID,IG
MOVE IE,X1
MOVE IG,Y1
SUB X1,IC
SUB Y1,ID
PUSH P,X1
PUSH P,Y1
MOVE X1,[XWD X2,SAVX]
BLT X1,SAVX+3
PUSHJ P,RPOINT
MOVE X1,[XWD SAVX,X2]
BLT X1,IG
MOVE IC,IE
MOVE ID,IG
MOVE IE,X2
MOVE IG,Y2
SUB X2,IC
SUB Y2,ID
PUSH P,X2
PUSH P,Y2
MOVEM IE,SAVX+2
MOVEM IG,SAVX+3
MOVEI X1,RPOINT
SKIP TS
MOVEI X1,RVECT
PUSHJ P,(X1)
MOVE IE,SAVX+2
MOVE IG,SAVX+3
PL2: AOS IB,SAVX+4
JRST EAX7-2
; LNES
EXTERNAL ALINE,CVLIN
LNES: SETZM II1#
MOVE DRX
FSC 233
FADR [0.5]
MOVEM DX#
MOVE DRY
FSC 233
FADR [0.5]
MOVEM DY#
AOS 1,II1
LN1: CAMLE 1,MAXNOL ;AC1 = I1
POPJ P,
LCRE8: SKIPG 2,.(1)
AOJA 1,LN1
ANDI 2,7777
CAML 2,LNCRE1
CAMLE 2,LNCRE2
AOJA 1,LN1
MOVEI 2,(1)
LSH 2,1 ;AC2 = I2←I1*2
MOVEI 3,-1(2) ;AC3 = I2-1
SKIPN CVLIN
JRST LN2
LVC1: MOVE 4,.(3) ;AC4 = I3←LVERCO ENTRY
XVC4: MOVE 5,.(4)
YVC4: MOVE 6,.(4)
LVC2: MOVE 4,.(2)
XVC5: MOVE 7,.(4)
YVC5: MOVE 10,.(4)
JRST LN3
LN2:
XLC14: MOVE 5,.(3)
YLC14: MOVE 6,.(3)
XLC15: MOVE 7,.(2)
YLC15: MOVE 10,.(2)
LN3: DISX 5
DISY 6
DISX 7
DISY 10
PUSH P,5
PUSH P,6
PUSH P,7
PUSH P,10
MOVEM 1,II1
PUSHJ P,ALINE
JRST LN1-1
END